home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / lcu.zip / FILEFCNS.PAS < prev    next >
Pascal/Delphi Source File  |  1993-01-04  |  7KB  |  303 lines
  1. {$R-}    {Range checking off}
  2. {$B-}    {Boolean complete evaluation off}
  3. {$S-}    {Stack checking off}
  4. {$N-}    {No numeric coprocessor}
  5. {$I-}    {IO Checking Off}
  6. {$D+}
  7. {$T+}
  8.  
  9. unit FileFcns;
  10. {JW Sparks, last revised 06/30/88}
  11.  
  12. interface
  13. uses Crt, Dos, Colors, ErrProcs, MemComp;
  14.  
  15. Const
  16.    MaxFileBufSize = $FE00;
  17.  
  18. Function  FileComp(SourceName,DestName:String; var ErrorNumber: Integer): Boolean;
  19.  
  20. Procedure FileCopy(SourceName,DestName:String; var ErrorNumber: Integer);
  21.  
  22. Function GetCopyBufferSize: LongInt;
  23.  
  24. Function GetCompareBufferSize: LongInt;
  25.  
  26. {-----}
  27.  
  28. Implementation
  29.  
  30. {***}
  31.  
  32. Function GetCompareBufferSize: LongInt;
  33. begin
  34. {Need to set up two buffers for compare}
  35. If ( (MaxAvail - 32) > (2 * MaxFileBufSize) ) then
  36.         GetCompareBufferSize := MaxFileBufSize
  37.    else GetCompareBufferSize := (MaxAvail - 32) div 2;
  38.  
  39. end;
  40.  
  41. {***}
  42.  
  43. Function GetCopyBufferSize: LongInt;
  44. begin
  45. {Need to set up one buffer for copy}
  46. If ( (MaxAvail - 16) >  MaxFileBufSize ) then
  47.         GetCopyBufferSize := MaxFileBufSize
  48.    else GetCopyBufferSize := MaxAvail - 16;
  49. end;
  50.  
  51. {***}
  52.  
  53. Function FileComp(SourceName,DestName:String; var ErrorNumber: Integer): Boolean;
  54. {Compares two Files, returns TRUE if identical}
  55. Type
  56.    FileBufPtr       = ^FileBuffer;
  57.    FileBuffer       = record
  58.                      ByteArray : array[1..MaxFileBufSize] of Byte;
  59.                   end;
  60. var
  61.    SourceBufPtr : FileBufPtr;
  62.    DestBufPtr   : FileBufPtr;
  63.    BufSize      : LongInt;
  64.  
  65.    Source, Dest : File;
  66.    SourceSize   : LongInt;
  67.    DestSize     : LongInt;
  68.  
  69.    BytesThisCycle : word;
  70.    W              : word;
  71.  
  72.    MemoryAvailable: LongInt;
  73.    BytesSoFar     : LongInt;
  74.    Compare        : Boolean;
  75.  
  76. Begin
  77. FileComp := FALSE;
  78.  
  79. FileMode := 0;
  80. Assign(Source, SourceName);
  81. Reset(Source, 1);
  82. IOCheck(ErrorNumber, [1..255]);
  83. FileMode := 2;
  84. if (IOErr=True) then
  85.    begin
  86.    close(Source);
  87.    Exit;
  88.    end;
  89. SourceSize := FileSize(Source);
  90.  
  91. FileMode := 0;
  92. Assign(Dest,DestName);
  93. Reset(Dest, 1);
  94. IOCheck(ErrorNumber, [1..255]);
  95.  
  96. FileMode := 2;
  97. if (IOErr=TRUE) then
  98.    begin
  99.    close(Source);
  100.    close(Dest);
  101.    Exit;
  102.    end;
  103. DestSize := FileSize(Dest);
  104.  
  105. WriteLn('Comparing ',SourceName,' (', SourceSize, ' bytes)');
  106. WriteLn('     with ',DestName, ' (', DestSize, ' bytes)' );
  107.  
  108. If SourceSize <> DestSize then begin
  109.    TextColor(Emphasized);
  110.    Writeln('File Lengths are DIFFERENT');
  111.    TextColor(Foreground);
  112.    close(Source);
  113.    close(Dest);
  114.    exit;
  115.    end;
  116.  
  117. BufSize := GetCompareBufferSize;
  118. GetMem(SourceBufPtr, BufSize);
  119. GetMem(DestBufPtr,   BufSize);
  120. BytesSoFar := 0;
  121.  
  122. Repeat
  123.    BytesThisCycle := BufSize;
  124.    BlockRead(Source, SourceBufPtr^, BufSize, BytesThisCycle);
  125.    BlockRead(Dest  , DestBufPtr^  , BufSize, BytesThisCycle);
  126.    W := CompMem(SourceBufPtr^, DestBufPtr^, BytesThisCycle);
  127.  
  128.    if (W = 0) then
  129.       begin
  130.          Compare := TRUE;
  131.          BytesSoFar := BytesSoFar + BytesThisCycle;
  132.       end
  133.     else
  134.        begin
  135.           Compare := FALSE;
  136.           BytesSoFar := BytesSoFar + W;
  137.           TextColor(Warning);
  138.           WriteLn('Compare Error at postition ', BytesSoFar, ' bytes');
  139.           TextColor(Foreground);
  140.        end;
  141. until ( (Compare=False) or (EOF(Source)) );
  142.  
  143. close(Source);
  144. close(Dest);
  145.  
  146. FreeMem(SourceBufPtr, BufSize);
  147. FreeMem(DestBufPtr,   BufSize);
  148. FileComp := Compare;
  149.  
  150. end;
  151.  
  152. {***}
  153.  
  154. Procedure FileCopy(SourceName,DestName:String; var ErrorNumber: Integer);
  155. {Copies File: SourceName to DestName; returns ErrorNumber := 0 if successful,
  156.  Returns ErrorNumber=200 if not enough space on destination drive
  157.          ErrorNumber=210 if FileCopy aborted}
  158.  
  159. Const
  160.    MaxFileBufSize   = $FE00;
  161. Type
  162.    FileBufPtr       = ^FileBuffer;
  163.    FileBuffer       =  record
  164.                      ByteArray : array[1..MaxFileBufSize] of Byte;
  165.                    end;
  166. Var
  167.  
  168.    MemoryAvailable : longInt;
  169.  
  170.    InBufPtr     : FileBufPtr;
  171.    Source, Dest : File;
  172.    SourceSize   : longint;
  173.    FileTimeDate : LongInt;
  174.    DiskNum      : Word;
  175.    Attribute    : word;
  176.  
  177.    BufSize         : Word;
  178.    BytesThisCycle  : Word;
  179.    C               : Char;
  180.    NewPathName     : String;
  181.  
  182. Begin
  183. ErrorNumber := 0;
  184.  
  185. FileMode := 0;
  186. Assign(Source, SourceName);
  187. Reset(Source, 1);
  188. IOCheck(ErrorNumber, [1..255]);
  189. FileMode := 2;
  190. if (IOErr=TRUE) then
  191.    begin
  192.    Close(Source);
  193.    Exit;
  194.    end;
  195. SourceSize := FileSize(Source);
  196.  
  197. FileMode := 2;
  198. Assign(Dest,DestName);
  199. GetFAttr(Dest, Attribute);
  200. if DosError=3 then
  201.    begin
  202.       NewPathName := '';
  203.       while pos('\', DestName)>0 do begin
  204.          NewPathName := NewPathName + copy(DestName, 1, pos('\', DestName) );
  205.          Delete(DestName, 1, Pos('\', DestName) );
  206.          end;
  207.       TextColor(Warning);
  208.       WriteLn(#7, 'Path Does Not Exist: ', NewPathName);
  209.       Write('Would You Like to Create it? ');
  210.       C := ReadKey;
  211.       C := upcase(C);
  212.       WriteLn(C);
  213.       If C = 'Y' then {Create new directory on destination disk}
  214.          begin
  215.             Delete(NewPathName, length(NewPathName), 1);
  216.             MkDir(NewPathName);
  217.             IOCheck(ErrorNumber, [1..255]);
  218.             DestName := NewPathName + '\' + DestName;
  219.             if IOErr=FALSE then
  220.                WriteLn('New Subdirectory created: ', NewPathName)
  221.             else
  222.                begin
  223.                   WriteLn('Unable to Create Subdirectory: ', NewPathName);
  224.                   TextColor(ForeGround);
  225.                   Close(Source);
  226.                   exit;
  227.                end;
  228.          end
  229.       else
  230.          begin
  231.                TextColor(ForeGround);
  232.                ErrorNumber := 210;
  233.                Close(Source);
  234.                exit;
  235.          end;
  236.    end; {DosError=3}
  237.  
  238. if ( (Attribute and ReadOnly) > 0 ) then
  239.    begin
  240.       TextColor(Warning);
  241.       WriteLn(#7, 'Destination File Exists, and is Read Only : ', DestName);
  242.       Write(#7, 'Would You Like to Overwrite (Delete) it? ');
  243.       C := ReadKey;
  244.       C := upcase(C);
  245.       WriteLn(C);
  246.       If C = 'Y' then SetFAttr(Dest,0)
  247.       else
  248.          begin
  249.             TextColor(ForeGround);
  250.             Close(Source);
  251.             ErrorNumber := 210;
  252.             exit;
  253.          end;
  254. end; {if readonly}
  255.  
  256. TextColor(Foreground);
  257. Erase(Dest);
  258. IOCheck(ErrorNumber, [1..255]-[2,18]);
  259.  
  260. if DestName[2]=':' then
  261.    DiskNum := ord(upcase(DestName[1]))-64
  262. else DiskNum := 0;
  263.  
  264. if (SourceSize > DiskFree(DiskNum) ) then
  265.    begin
  266.       ErrorNumber := 200;
  267.       close(Source);
  268.       exit;
  269.    end;
  270.  
  271. ReWrite(Dest, 1);
  272. IOCheck(ErrorNumber, [1..255]-[2, 18]);
  273.  
  274. if (IOErr=TRUE) then
  275.    begin
  276.    close(Source);
  277.    close(Dest);
  278.    exit;
  279.    end;
  280.  
  281. BufSize := GetCopyBufferSize;
  282. GetMem(InBufPtr, BufSize);
  283. BytesThisCycle := BufSize;
  284.  
  285. WriteLn('Copying:  ',SourceName, ' (',SourceSize,' bytes)');
  286. Write(' ----->>  ',DestName);
  287.  
  288. Repeat
  289. BlockRead (Source, InBufPtr^, BufSize, BytesThisCycle);
  290. BlockWrite(Dest,   InBufPtr^, BytesThisCycle);
  291. until EOF(Source);
  292.  
  293. GetFTime(Source, FileTimeDate);
  294. SetFTime(Dest,   FileTimeDate);
  295. close(Source);
  296. close(Dest);
  297. FreeMem(InBufPtr,BufSize);
  298. end; {FileCopy}
  299.  
  300. {***}
  301.  
  302.  end. {Unit: FileFcns}
  303.